perm filename THGOAL[P,JRA] blob sn#077929 filedate 1973-12-13 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP THGOAL 
00400	 (LAMBDA(THA)
00500	  (PROG (THX THY THY1 THZ THZ1 THA1 THA2 THV)
00600		(SETQ THV (QUOTE (THV)))
00700		(SETQ THA2 (THVARSUBST (CAR THA)))
00750	(PRINT @T750)(PRINT CT)
00800		(THVAL (QUOTE (SAVAR (CAR THA))) THALIST)
00850	(PRINT @T850)(PRINT CT)
00900		(COND (SRULES (SETQ THA2 (SIMPLE THA2))))
01000		(SETQ THA1 (CDR THA))
01100		(COND
01200		 ((OR (NULL THA1)
01300		      (AND (NOT (AND (EQ (CAAR THA1) (QUOTE THNODB)) (PROG2 (SETQ THA1 (CDR THA1)) T)))
01400			   (NOT (EQ (CAAR THA1) (QUOTE THDBF)))))
01500		  (SETQ THY1 T)
01600		  (SETQ THX (LIST (LIST (QUOTE THDBF) (QUOTE THTRUE) (SETQ THY (THMATCHDB THA2)))))
01650	(PRINT @T1650)
01700		  (COLLECTDB THY)(PRINT @T1700)(PRINT CT)))
01800		(SETQ THX (NCONC THX (MAPCAR (FUNCTION THTRY) THA1)))
01900		(AND THTRACE (THTRACES (QUOTE THGOAL) THA2))
02000		(THPUSH THTREE (LIST (QUOTE THGOAL) THA2 THX))
02100		(RETURN NIL))) 
02200	FEXPR)